perm filename PPCODE.SAI[PNT,HE]1 blob
sn#417615 filedate 1979-02-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00006 ENDMK
C⊗;
ENTRY;
BEGIN
DEFINE $$PRGID=TRUE, $PPCODE=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
DEFINE II=0;
DEFINE MAKEOP(OPNUM,OPNAM)"[]"=
[ REDEFINE II = II + 2 ;
DEFINE OPNUM = II ; ];
COMMENT REQUIRE "MOVE.DEF[PNT,HE]" SOURCE_FILE;
REQUIRE "INTOPS.SAI" SOURCE_FILE;
DEFINE #ALINTOPS = II ;
REQUIRE "[][]" DELIMITERS;
DEFINE III =["not valid"];
REDEFINE MAKEOP(OPNUM,OPNAM) = [REDEFINE III=cvms(III)&[,"]&CVPS(OPNAM)&["];];
REQUIRE "INTOPS.SAI" SOURCE_FILE;
PRESET_WITH III;
STRING ARRAY SPCODE[0:#ALINTOPS/2];
SIMPLE INTEGER PROCEDURE PCODE(STRING S);
BEGIN INTEGER I;
FOR I←#ALINTOPS/2 STEP -1 UNTIL 1 DO IF EQU(S,SPCODE[I]) THEN RETURN(I);
RETURN(0);
END;
SIMPLE STRING PROCEDURE SCODE(INTEGER I);
IF I MOD 2 = 0 AND 0≤I≤#ALINTOPS THEN RETURN(SPCODE[I/2])
ELSE RETURN(SPCODE[0]);
INTERNAL PROCEDURE PPCODE(RPTR(EXPR$)EE;INTEGER SNUM(1));
BEGIN
! program to print out pcode from number form to pcode form;
INTEGER INDEX,INDEXF;
PROCEDURE RPRINT;
BEGIN
PRINT(" ",RFVAL(EXPR$:BODY[EE][INDEX+1],
EXPR$:BODY[EE][INDEX+2]));
INDEX←INDEX+2;
END;
! PROCEDURE LPRINT;
! PRINT(" .+ ",EXPR$:BODY[EE][INDEX←INDEX+1]-GRINCH2);
PROCEDURE OPRINT;
PRINT(" ",CVOS(EXPR$:BODY[EE][INDEX←INDEX+1]));
PROCEDURE DPRINT;
PRINT(" .+ ",EXPR$:BODY[EE][INDEX←INDEX+1],"(D)");
PROCEDURE NPCODE;
BEGIN
INTEGER I,J;
I←EXPR$:BODY[EE][INDEX←INDEX+1]/2;
J←EXPR$:BODY[EE][INDEX] MOD 2;
IF J=0 AND 1≤I≤ARRINFO(SPCODE,2)
THEN PRINT(CRLF," ",SPCODE[I])
ELSE PRINT(CRLF," ",EXPR$:BODY[EE][INDEX],"(D)");
IF J=0 THEN
CASE I OF
BEGIN
[XJUMP/2][XPRINT/2][XJUMPC/2][XFORCHK/2]
DPRINT;
[XRJMP/2][XRPRINT/2][XRJMPC/2][XRFRCHK/2]
DPRINT;
[XPUSHSCI/2]
RPRINT;
[XAFFIX/2]
BEGIN
OPRINT; OPRINT; OPRINT;
IF EXPR$:BODY[EE][INDEX] LAND '2000 THEN OPRINT;
END;
[XAGTVAL/2][XACHNGE/2][XARTVAL/2]
BEGIN OPRINT; OPRINT; END;
[XGTVAL/2][XCHNGE/2][XWHERE/2][XPUSHINTI/2][XKVAR/2]
[XGTBLK/2][XCOPY/2][XRETURN/2][XPROC/2][XREPLAC/2]
[XGATHER/2]
OPRINT;
[XRCENTER/2][XRPMOVE/2]
[XRTADRIVE/2][XRTDDRIVE/2]
BEGIN DPRINT; OPRINT; END;
[XMVAR/2]
DO OPRINT UNTIL
EXPR$:BODY[EE][INDEX]=0;
ELSE INDEX←INDEX
END;
END;
INDEX←SNUM-1;INDEXF←EXPR$:#BODY[EE];
WHILE INDEX<INDEXF DO NPCODE;
END;
PROCEDURE PPPCODE;ppcode(null_record);
END;